home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / src / math.c < prev    next >
C/C++ Source or Header  |  1992-10-21  |  17KB  |  753 lines
  1. /* Generic math functions
  2.  */
  3.  
  4. #include <math.h>
  5. #include <errno.h>
  6.  
  7. #include "scheme.h"
  8.  
  9. extern int errno;
  10.  
  11. Object Generic_Multiply(), Generic_Divide();
  12.  
  13. Init_Math () {
  14. #ifdef RANDOM
  15.     srandom (getpid ());
  16. #else
  17.     srand (getpid ());
  18. #endif
  19. }
  20.  
  21. Object Make_Fixnum (n) register n; {
  22.     Object num;
  23.  
  24.     SET(num, T_Fixnum, n);
  25.     return num;
  26. }
  27.  
  28. Object Make_Integer (n) register n; {
  29.     if (FIXNUM_FITS(n))
  30.     return Make_Fixnum (n);
  31.     else
  32.     return Integer_To_Bignum (n);
  33. }
  34.  
  35. Object Make_Unsigned (n) register unsigned n; {
  36.     if (FIXNUM_FITS_UNSIGNED(n))
  37.     return Make_Fixnum (n);
  38.     else
  39.     return Unsigned_To_Bignum (n);
  40. }
  41.  
  42. Object Fixnum_To_String (x, radix) Object x; {
  43.     char buf[32];
  44.     register char *p;
  45.     register n = FIXNUM(x), neg = 0;
  46.  
  47.     if (n == 0)
  48.     return Make_String ("0", 1);
  49.     if (n < 0) {
  50.     neg++;
  51.     n = -n;
  52.     }
  53.     p = buf+31;
  54.     *p = '\0';
  55.     while (n > 0) {
  56.     *--p = '0' + n % radix;
  57.     if (*p > '9')
  58.         *p = 'A' + (*p - '9') - 1;
  59.     n /= radix;
  60.     }
  61.     if (neg)
  62.     *--p = '-';
  63.     return Make_String (p, strlen (p));
  64. }
  65.  
  66. Object Flonum_To_String (x) Object x; {
  67.     char buf[32];
  68.  
  69.     sprintf (buf, FLONUM_FORMAT, FLONUM(x)->val);
  70.     return Make_String (buf, strlen (buf));
  71. }
  72.  
  73. Object P_Number_To_String (argc, argv) Object *argv; {
  74.     int radix = 10;
  75.     Object x = argv[0];
  76.  
  77.     if (argc == 2) {
  78.     radix = Get_Integer (argv[1]);
  79.     switch (radix) {
  80.     case 2: case 8: case 10: case 16:
  81.         break;
  82.     default:
  83.         Primitive_Error ("invalid radix: ~s", argv[1]);
  84.     }
  85.     }
  86.     switch (TYPE(x)) {
  87.     case T_Fixnum:
  88.     return Fixnum_To_String (x, radix);
  89.     case T_Bignum:
  90.     return Bignum_To_String (x, radix);
  91.     case T_Flonum:
  92.     if (radix != 10)
  93.         Primitive_Error ("radix for reals must be 10");   /* bleah! */
  94.     return Flonum_To_String (x);
  95.     }
  96.     /*NOTREACHED*/
  97. }
  98.  
  99. Get_Integer (x) Object x; {
  100.     switch (TYPE(x)) {
  101.     case T_Fixnum:
  102.     return FIXNUM(x);
  103.     case T_Bignum:
  104.     return Bignum_To_Integer (x);
  105.     default:
  106.     Wrong_Type (x, T_Fixnum);
  107.     }
  108.     /*NOTREACHED*/
  109. }
  110.  
  111. Get_Index (n, obj) Object n, obj; {
  112.     register size, i;
  113.  
  114.     i = Get_Integer (n);
  115.     size = TYPE(obj) == T_Vector ? VECTOR(obj)->size : STRING(obj)->size;
  116.     if (i < 0 || i >= size)
  117.     Range_Error (n);
  118.     return i;
  119. }
  120.  
  121. Object Make_Reduced_Flonum (d) double d; {
  122.     Object num;
  123.     int expo;
  124.  
  125.     if (floor (d) == d) {
  126.     if (d == 0)
  127.         return Zero;
  128.     (void)frexp (d, &expo);
  129.     if (expo <= VALBITS-1)
  130.         return Make_Fixnum ((int)d);
  131.     }
  132.     num = Alloc_Object (sizeof (struct S_Flonum), T_Flonum, 0);
  133.     FLONUM(num)->tag = Null;
  134.     FLONUM(num)->val = d;
  135.     return num;
  136. }
  137.  
  138. Object Fixnum_Multiply (a, b) {
  139.     register unsigned aa = a;
  140.     register unsigned ab = b;
  141.     register unsigned prod, prod2;
  142.     register sign = 1;
  143.     if (a < 0) {
  144.     aa = -a;
  145.     sign = -1;
  146.     }
  147.     if (b < 0) {
  148.     ab = -b;
  149.     sign = -sign;
  150.     }
  151.     prod = (aa & 0xFFFF) * (ab & 0xFFFF);
  152.     if (aa & 0xFFFF0000) {
  153.     if (ab & 0xFFFF0000)
  154.         return Null;
  155.     prod2 = (aa >> 16) * ab;
  156.     } else {
  157.     prod2 = aa * (ab >> 16);
  158.     }
  159.     prod2 += prod >> 16;
  160.     prod &= 0xFFFF;
  161.     if (prod2 > (1 << (VALBITS - 1 - 16)) - 1) {
  162.     if (sign == 1 || prod2 != (1 << (VALBITS - 1 - 16)) || prod != 0)
  163.         return Null;
  164.     return Make_Fixnum (-SIGNBIT);
  165.     }
  166.     prod += prod2 << 16;
  167.     if (sign == -1)
  168.     prod = - prod;
  169.     return Make_Fixnum (prod);
  170. }
  171.  
  172. Object P_Integerp (x) Object x; {
  173.     return TYPE(x) == T_Fixnum || TYPE(x) == T_Bignum ? True : False;
  174. }
  175.  
  176. Object P_Rationalp (x) Object x; {
  177.     return P_Integerp (x);
  178. }
  179.  
  180. Object P_Realp (x) Object x; {
  181.     register t = TYPE(x);
  182.     return t == T_Flonum || t == T_Fixnum  || t == T_Bignum ? True : False;
  183. }
  184.  
  185. Object P_Complexp (x) Object x; {
  186.     return P_Realp (x);
  187. }
  188.  
  189. Object P_Numberp (x) Object x; {
  190.     return P_Complexp (x);
  191. }
  192.  
  193. #define General_Generic_Predicate(prim,op,bigop) Object prim (x) Object x; {\
  194.     register ret;\
  195.     Check_Number (x);\
  196.     switch (TYPE(x)) {\
  197.     case T_Flonum:\
  198.     ret = FLONUM(x)->val op 0; break;\
  199.     case T_Fixnum:\
  200.     ret = FIXNUM(x) op 0; break;\
  201.     case T_Bignum:\
  202.     ret = bigop (x); break;\
  203.     }\
  204.     return ret ? True : False;\
  205. }
  206.  
  207. General_Generic_Predicate (P_Zerop, ==, Bignum_Zero)
  208. General_Generic_Predicate (P_Negativep, <, Bignum_Negative)
  209. General_Generic_Predicate (P_Positivep, >, Bignum_Positive)
  210.  
  211. Object P_Evenp (x) Object x; {
  212.     register ret;
  213.  
  214.     Check_Integer (x);
  215.     switch (TYPE(x)) {
  216.     case T_Fixnum:
  217.     ret = !(FIXNUM(x) & 1); break;
  218.     case T_Bignum:
  219.     ret = Bignum_Even (x); break;
  220.     }
  221.     return ret ? True : False;
  222. }
  223.  
  224. Object P_Oddp (x) Object x; {
  225.     Object tmp;
  226.     tmp = P_Evenp (x);
  227.     return EQ(tmp,True) ? False : True;
  228. }
  229.  
  230. Object P_Exactp (x) Object x; {
  231.     Check_Number (x);
  232.     return False;
  233. }
  234.  
  235. Object P_Inexactp (x) Object x; {
  236.     Check_Number (x);
  237.     return True;
  238. }
  239.  
  240. #define General_Generic_Compare(name,op,bigop) name (x, y) Object x, y; {\
  241.     Object b; register ret;\
  242.     GC_Node;\
  243.     \
  244.     switch (TYPE(x)) {\
  245.     case T_Fixnum:\
  246.     switch (TYPE(y)) {\
  247.     case T_Fixnum:\
  248.         return FIXNUM(x) op FIXNUM(y);\
  249.     case T_Flonum:\
  250.         return FIXNUM(x) op FLONUM(y)->val;\
  251.     case T_Bignum:\
  252.         GC_Link (y);\
  253.         b = Integer_To_Bignum (FIXNUM(x));\
  254.         ret = bigop (b, y);\
  255.         GC_Unlink;\
  256.         return ret;\
  257.     }\
  258.     case T_Flonum:\
  259.     switch (TYPE(y)) {\
  260.     case T_Fixnum:\
  261.         return FLONUM(x)->val op FIXNUM(y);\
  262.     case T_Flonum:\
  263.         return FLONUM(x)->val op FLONUM(y)->val;\
  264.     case T_Bignum:\
  265.         return FLONUM(x)->val op Bignum_To_Double (y);\
  266.     }\
  267.     case T_Bignum:\
  268.     switch (TYPE(y)) {\
  269.     case T_Fixnum:\
  270.         GC_Link (x);\
  271.         b = Integer_To_Bignum (FIXNUM(y));\
  272.         ret = bigop (x, b);\
  273.         GC_Unlink;\
  274.         return ret;\
  275.     case T_Flonum:\
  276.         return Bignum_To_Double (x) op FLONUM(y)->val;\
  277.     case T_Bignum:\
  278.         return bigop (x, y);\
  279.     }\
  280.     }\
  281.     /*NOTREACHED*/ /* ...but lint never sees it */\
  282. }
  283.  
  284. General_Generic_Compare (Generic_Equal,      ==, Bignum_Equal)
  285. General_Generic_Compare (Generic_Less,        <, Bignum_Less)
  286. General_Generic_Compare (Generic_Greater,     >, Bignum_Greater)
  287. General_Generic_Compare (Generic_Eq_Less,    <=, Bignum_Eq_Less)
  288. General_Generic_Compare (Generic_Eq_Greater, >=, Bignum_Eq_Greater)
  289.  
  290. Object General_Compare (argc, argv, op) Object *argv; register (*op)(); {
  291.     register i;
  292.  
  293.     Check_Number (argv[0]);
  294.     for (i = 1; i < argc; i++) {
  295.     Check_Number (argv[i]);
  296.     if (!(*op) (argv[i-1], argv[i]))
  297.         return False;
  298.     }
  299.     return True;
  300. }
  301.  
  302. Object P_Generic_Equal (argc, argv) Object *argv; {
  303.     return General_Compare (argc, argv, Generic_Equal);
  304. }
  305.  
  306. Object P_Generic_Less (argc, argv) Object *argv; {
  307.     return General_Compare (argc, argv, Generic_Less);
  308. }
  309.  
  310. Object P_Generic_Greater (argc, argv) Object *argv; {
  311.     return General_Compare (argc, argv, Generic_Greater);
  312. }
  313.  
  314. Object P_Generic_Eq_Less (argc, argv) Object *argv; {
  315.     return General_Compare (argc, argv, Generic_Eq_Less);
  316. }
  317.  
  318. Object P_Generic_Eq_Greater (argc, argv) Object *argv; {
  319.     return General_Compare (argc, argv, Generic_Eq_Greater);
  320. }
  321.  
  322. #define General_Generic_Operator(name,op,bigop) Object name (x, y)\
  323.     Object x, y; {\
  324.     Object b1, b2, ret; register i;\
  325.     GC_Node2;\
  326.     \
  327.     switch (TYPE(x)) {\
  328.     case T_Fixnum:\
  329.     switch (TYPE(y)) {\
  330.     case T_Fixnum:\
  331.         i = FIXNUM(x) op FIXNUM(y);\
  332.         if (FIXNUM_FITS(i))\
  333.         return Make_Fixnum (i);\
  334.         b1 = b2 = Null;\
  335.         GC_Link2 (b1, b2);\
  336.         b1 = Integer_To_Bignum (FIXNUM(x));\
  337.         b2 = Integer_To_Bignum (FIXNUM(y));\
  338.         ret = bigop (b1, b2);\
  339.         GC_Unlink;\
  340.         return ret;\
  341.     case T_Flonum:\
  342.         return Make_Reduced_Flonum (FIXNUM(x) op FLONUM(y)->val);\
  343.     case T_Bignum:\
  344.         GC_Link (y);\
  345.         b1 = Integer_To_Bignum (FIXNUM(x));\
  346.         ret = bigop (b1, y);\
  347.         GC_Unlink;\
  348.         return ret;\
  349.     }\
  350.     case T_Flonum:\
  351.     switch (TYPE(y)) {\
  352.     case T_Fixnum:\
  353.         return Make_Reduced_Flonum (FLONUM(x)->val op FIXNUM(y));\
  354.     case T_Flonum:\
  355.         return Make_Reduced_Flonum (FLONUM(x)->val op FLONUM(y)->val);\
  356.     case T_Bignum:\
  357.         return Make_Reduced_Flonum (FLONUM(x)->val op\
  358.         Bignum_To_Double (y));\
  359.     }\
  360.     case T_Bignum:\
  361.     switch (TYPE(y)) {\
  362.     case T_Fixnum:\
  363.         GC_Link (x);\
  364.         b1 = Integer_To_Bignum (FIXNUM(y));\
  365.         ret = bigop (x, b1);\
  366.         GC_Unlink;\
  367.         return ret;\
  368.     case T_Flonum:\
  369.         return Make_Reduced_Flonum (Bignum_To_Double (x) op\
  370.         FLONUM(y)->val);\
  371.     case T_Bignum:\
  372.         return bigop (x, y);\
  373.     }\
  374.     }\
  375.     /*NOTREACHED*/ /* ...but lint never sees it */\
  376. }
  377.  
  378. General_Generic_Operator (Generic_Plus,      +, Bignum_Plus)
  379. General_Generic_Operator (Generic_Minus,     -, Bignum_Minus)
  380.  
  381. Object P_Inc (x) Object x; {
  382.     Check_Number (x);
  383.     return Generic_Plus (x, One);
  384. }
  385.  
  386. Object P_Dec (x) Object x; {
  387.     Check_Number (x);
  388.     return Generic_Minus (x, One);
  389. }
  390.  
  391. Object General_Operator (argc, argv, start, op) Object *argv, start;
  392.     register Object (*op)(); {
  393.     register i;
  394.     Object accum;
  395.  
  396.     if (argc > 0)
  397.     Check_Number (argv[0]);
  398.     accum = start;
  399.     switch (argc) {
  400.     case 0:
  401.     break;
  402.     case 1:
  403.     accum = (*op) (accum, argv[0]); break;
  404.     default:
  405.     for (accum = argv[0], i = 1; i < argc; i++) {
  406.         Check_Number (argv[i]);
  407.         accum = (*op) (accum, argv[i]);
  408.     }
  409.     }
  410.     return accum;
  411. }
  412.  
  413. Object P_Generic_Plus (argc, argv) Object *argv; {
  414.     return General_Operator (argc, argv, Zero, Generic_Plus);
  415. }
  416.  
  417. Object P_Generic_Minus (argc, argv) Object *argv; {
  418.     return General_Operator (argc, argv, Zero, Generic_Minus);
  419. }
  420.  
  421. Object P_Generic_Multiply (argc, argv) Object *argv; {
  422.     return General_Operator (argc, argv, One, Generic_Multiply);
  423. }
  424.  
  425. Object P_Generic_Divide (argc, argv) Object *argv; {
  426.     return General_Operator (argc, argv, One, Generic_Divide);
  427. }
  428.  
  429. Object Generic_Multiply (x, y) Object x, y; {
  430.     Object b, ret;
  431.  
  432.     switch (TYPE(x)) {
  433.     case T_Fixnum:
  434.     switch (TYPE(y)) {
  435.     case T_Fixnum:
  436.         ret = Fixnum_Multiply (FIXNUM(x), FIXNUM(y));
  437.         if (Nullp (ret)) {
  438.         b = Integer_To_Bignum (FIXNUM(x));
  439.         return Bignum_Fixnum_Multiply (b, y);
  440.         }
  441.         return ret;
  442.     case T_Flonum:
  443.         return Make_Reduced_Flonum (FIXNUM(x) * FLONUM(y)->val);
  444.     case T_Bignum:
  445.         return Bignum_Fixnum_Multiply (y, x);
  446.     }
  447.     case T_Flonum:
  448.     switch (TYPE(y)) {
  449.     case T_Fixnum:
  450.         return Make_Reduced_Flonum (FLONUM(x)->val * FIXNUM(y));
  451.     case T_Flonum:
  452.         return Make_Reduced_Flonum (FLONUM(x)->val * FLONUM(y)->val);
  453.     case T_Bignum:
  454.         return Make_Reduced_Flonum (FLONUM(x)->val * Bignum_To_Double (y));
  455.     }
  456.     case T_Bignum:
  457.     switch (TYPE(y)) {
  458.     case T_Fixnum:
  459.         return Bignum_Fixnum_Multiply (x, y);
  460.     case T_Flonum:
  461.         return Make_Reduced_Flonum (Bignum_To_Double (x) * FLONUM(y)->val);
  462.     case T_Bignum:
  463.         return Bignum_Multiply (x, y);
  464.     }
  465.     }
  466.     /*NOTREACHED*/
  467. }
  468.  
  469. Object Generic_Divide (x, y) Object x, y; {
  470.     register t = TYPE(y);
  471.     Object b, ret;
  472.     GC_Node2;
  473.  
  474.     if (t == T_Fixnum ? FIXNUM(y) == 0 :
  475.     (t == T_Flonum ? FLONUM(y) == 0 : Bignum_Zero (y)))
  476.     Range_Error (y);
  477.     switch (TYPE(x)) {
  478.     case T_Fixnum:
  479.     switch (t) {
  480.     case T_Fixnum:
  481.         return Make_Reduced_Flonum ((double)FIXNUM(x) / (double)FIXNUM(y));
  482.     case T_Flonum:
  483.         return Make_Reduced_Flonum ((double)FIXNUM(x) / FLONUM(y)->val);
  484.     case T_Bignum:
  485.         GC_Link (y);
  486.         b = Integer_To_Bignum (FIXNUM(x));
  487.         ret = Bignum_Divide (b, y);
  488.         GC_Unlink;
  489.         if (EQ(Cdr (ret),Zero))
  490.         return Car (ret);
  491.         return Make_Reduced_Flonum ((double)FIXNUM(x) /
  492.             Bignum_To_Double (y));
  493.     }
  494.     case T_Flonum:
  495.     switch (t) {
  496.     case T_Fixnum:
  497.         return Make_Reduced_Flonum (FLONUM(x)->val / (double)FIXNUM(y));
  498.     case T_Flonum:
  499.         return Make_Reduced_Flonum (FLONUM(x)->val / FLONUM(y)->val);
  500.     case T_Bignum:
  501.         return Make_Reduced_Flonum (FLONUM(x)->val / Bignum_To_Double (y));
  502.     }
  503.     case T_Bignum:
  504.     switch (t) {
  505.     case T_Fixnum:
  506.         GC_Link (x);
  507.         ret = Bignum_Fixnum_Divide (x, y);
  508.         GC_Unlink;
  509.         if (EQ(Cdr (ret),Zero))
  510.         return Car (ret);
  511.         return Make_Reduced_Flonum (Bignum_To_Double (x) /
  512.             (double)FIXNUM(y));
  513.     case T_Flonum:
  514.         return Make_Reduced_Flonum (Bignum_To_Double (x) / FLONUM(y)->val);
  515.     case T_Bignum:
  516.         GC_Link2 (x, y);
  517.         ret = Bignum_Divide (x, y);
  518.         GC_Unlink;
  519.         if (EQ(Cdr (ret),Zero))
  520.         return Car (ret);
  521.         return Make_Reduced_Flonum (Bignum_To_Double (x) /
  522.             Bignum_To_Double (y));
  523.     }
  524.     }
  525.     /*NOTREACHED*/
  526. }
  527.  
  528. Object P_Abs (x) Object x; {
  529.     register i;
  530.  
  531.     Check_Number (x);
  532.     switch (TYPE(x)) {
  533.     case T_Fixnum:
  534.     i = FIXNUM(x);
  535.     return i < 0 ? Make_Integer (-i) : x;
  536.     case T_Flonum:
  537.     return Make_Reduced_Flonum (fabs (FLONUM(x)->val));
  538.     case T_Bignum:
  539.     return Bignum_Abs (x);
  540.     }
  541.     /*NOTREACHED*/
  542. }
  543.  
  544. Object General_Integer_Divide (x, y, rem) Object x, y; {
  545.     register fx = FIXNUM(x), fy = FIXNUM(y);
  546.     Object b, ret;
  547.     GC_Node;
  548.  
  549.     Check_Integer (x);
  550.     Check_Integer (y);
  551.     if (TYPE(y) == T_Fixnum ? FIXNUM(y) == 0 : Bignum_Zero (y))
  552.     Range_Error (y);
  553.     switch (TYPE(x)) {
  554.     case T_Fixnum:
  555.     switch (TYPE(y)) {
  556.     case T_Fixnum:
  557.         return Make_Fixnum (rem ? (fx % fy) : (fx / fy));
  558.     case T_Bignum:
  559.         GC_Link (y);
  560.         b = Integer_To_Bignum (fx);
  561.         GC_Unlink;
  562.         ret = Bignum_Divide (b, y);
  563. done:
  564.         return rem ? Cdr (ret) : Car (ret);
  565.     }
  566.     case T_Bignum:
  567.     switch (TYPE(y)) {
  568.     case T_Fixnum:
  569.         ret = Bignum_Fixnum_Divide (x, y);
  570.         goto done;
  571.     case T_Bignum:
  572.         ret = Bignum_Divide (x, y);
  573.         goto done;
  574.     }
  575.     }
  576.     /*NOTREACHED*/
  577. }
  578.  
  579. Object P_Quotient (x, y) Object x, y; {
  580.     return General_Integer_Divide (x, y, 0);
  581. }
  582.  
  583. Object P_Remainder (x, y) Object x, y; {
  584.     return General_Integer_Divide (x, y, 1);
  585. }
  586.  
  587. Object P_Modulo (x, y) Object x, y; {
  588.     Object rem, xneg, yneg;
  589.     GC_Node2;
  590.  
  591.     GC_Link2 (x, y);
  592.     rem = General_Integer_Divide (x, y, 1);
  593.     xneg = P_Negativep (x);
  594.     yneg = P_Negativep (y);
  595.     if (!EQ(xneg,yneg))
  596.     rem = Generic_Plus (rem, y);
  597.     GC_Unlink;
  598.     return rem;
  599. }
  600.  
  601. Object gcd (x, y) Object x, y; {
  602.     Object r, z;
  603.     GC_Node2;
  604.  
  605.     Check_Integer (x);
  606.     Check_Integer (y);
  607.     GC_Link2 (x, y);
  608.     while (1) {
  609.     z = P_Zerop (x);
  610.     if (EQ(z,True)) {
  611.         r = y;
  612.         break;
  613.     }
  614.     z = P_Zerop (y);
  615.     if (EQ(z,True)) {
  616.         r = x;
  617.         break;
  618.     }
  619.     r = General_Integer_Divide (x, y, 1);
  620.     x = y;
  621.     y = r;
  622.     }
  623.     GC_Unlink;
  624.     return r;
  625. }
  626.  
  627. Object P_Gcd (argc, argv) Object *argv; {
  628.     return P_Abs (General_Operator (argc, argv, Zero, gcd));
  629. }
  630.  
  631. Object lcm (x, y) Object x, y; {
  632.     Object ret, p, z;
  633.     GC_Node3;
  634.  
  635.     ret = Null;
  636.     GC_Link3 (x, y, ret);
  637.     ret = gcd (x, y);
  638.     z = P_Zerop (ret);
  639.     if (!EQ(z,True)) {
  640.     p = Generic_Multiply (x, y);
  641.     ret = General_Integer_Divide (p, ret, 0);
  642.     }
  643.     GC_Unlink;
  644.     return ret;
  645. }
  646.  
  647. Object P_Lcm (argc, argv) Object *argv; {
  648.     return P_Abs (General_Operator (argc, argv, One, lcm));
  649. }
  650.  
  651. #define General_Conversion(name,op) Object name (x) Object x; {\
  652.     double d; int expo;\
  653.     \
  654.     Check_Number (x);\
  655.     if (TYPE(x) != T_Flonum)\
  656.     return x;\
  657.     d = op (FLONUM(x)->val);\
  658.     (void)frexp (d, &expo);\
  659.     return (expo <= VALBITS-1) ? Make_Fixnum ((int)d) : Double_To_Bignum (d);\
  660. }
  661.  
  662. #define trunc(x) (x)
  663. #define round(x) ((x) >= 0 ? (x) + 0.5 : (x) - 0.5)
  664.  
  665. General_Conversion (P_Floor, floor)
  666. General_Conversion (P_Ceiling, ceil)
  667. General_Conversion (P_Truncate, trunc)
  668. General_Conversion (P_Round, round)
  669.  
  670. double Get_Double (x) Object x; {
  671.     Check_Number (x);
  672.     switch (TYPE(x)) {
  673.     case T_Fixnum:
  674.     return (double)FIXNUM(x);
  675.     case T_Flonum:
  676.     return FLONUM(x)->val;
  677.     case T_Bignum:
  678.     return Bignum_To_Double (x);
  679.     }
  680.     /*NOTREACHED*/
  681. }
  682.  
  683. Object General_Function (x, y, fun) Object x, y; double (*fun)(); {
  684.     double d, ret;
  685.  
  686.     d = Get_Double (x);
  687.     errno = 0;
  688.     if (Nullp (y))
  689.     ret = (*fun) (d);
  690.     else
  691.     ret = (*fun) (d, Get_Double (y));
  692.     if (errno == ERANGE || errno == EDOM)
  693.     Range_Error (x);
  694.     return Make_Reduced_Flonum (ret);
  695. }
  696.  
  697. Object P_Sqrt (x) Object x; { return General_Function (x, Null, sqrt); }
  698.  
  699. Object P_Exp (x) Object x; { return General_Function (x, Null, exp); }
  700.  
  701. Object P_Log (x) Object x; { return General_Function (x, Null, log); }
  702.  
  703. Object P_Sin (x) Object x; { return General_Function (x, Null, sin); }
  704.  
  705. Object P_Cos (x) Object x; { return General_Function (x, Null, cos); }
  706.  
  707. Object P_Tan (x) Object x; { return General_Function (x, Null, tan); }
  708.  
  709. Object P_Asin (x) Object x; { return General_Function (x, Null, asin); }
  710.  
  711. Object P_Acos (x) Object x; { return General_Function (x, Null, acos); }
  712.  
  713. Object P_Atan (argc, argv) Object *argv; {
  714.     register a2 = argc == 2;
  715.     return General_Function (argv[0], a2 ? argv[1] : Null, a2 ? 
  716.     (double(*)())atan2 : (double(*)())atan);
  717. }
  718.  
  719. Object Min (x, y) Object x, y; {
  720.     return Generic_Less (x, y) ? x : y;
  721. }
  722.  
  723. Object Max (x, y) Object x, y; {
  724.     return Generic_Less (x, y) ? y : x;
  725. }
  726.  
  727. Object P_Min (argc, argv) Object *argv; {
  728.     return General_Operator (argc, argv, argv[0], Min);
  729. }
  730.  
  731. Object P_Max (argc, argv) Object *argv; {
  732.     return General_Operator (argc, argv, argv[0], Max);
  733. }
  734.  
  735. Object P_Random () {
  736. #ifdef RANDOM
  737.     extern long random();
  738.     return Make_Integer ((int)random ());
  739. #else
  740.     return Make_Integer (rand ());
  741. #endif
  742. }
  743.  
  744. Object P_Srandom (x) Object x; {
  745.     Check_Integer (x);
  746. #ifdef RANDOM
  747.     srandom (Get_Integer (x));
  748. #else
  749.     srand (Get_Integer (x));
  750. #endif
  751.     return x;
  752. }
  753.